perm filename EADD5.2[EAL,HE]2 blob sn#704732 filedate 1983-04-04 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	{$NOMAIN	Editor: aux routines for addStmnt }
C00005 00003	procedure addEndStmnt (nextLinep: cursorpp var nogood,emptyp,flushp: boolean 
C00013 ENDMK
C⊗;
{$NOMAIN	Editor: aux routines for addStmnt }

%include eedit.hdr;

{ Externally defined routines from elsewhere: }

	(* XX From EEXTRA XX *)
procedure descend(st: statementp);				external;
function elseTest: boolean;					external;

	(* From EAUX1A *)
procedure adjustDisplay;					external;

	(* From EAUX1C *)
procedure errPrnt;						external;

	(* From EPUT *)
procedure putLine;						external;

	(* From EAUX2C *)
procedure displayLines(var pfrom: integer);			external;
procedure deleteLines(start,number,coff: integer);		external;
procedure insertLines(start,number,coff: integer);		external;

	(* From ETOKEN *)
procedure getToken;						external;

	(* From EPUTST *)
procedure putstmnt(s: statementp; indent, plevel: integer);	external;

	(* From EPAR3B *)
function idGet(st: statementp; indent,l: integer): ascii;	external;

	(* From EPAR3D *)
function addNewDeclarations: integer;				external;

	(* From PP *)
procedure relLine(l: linerecp);					external;
procedure ppLine; 						external;
procedure ppOutNow; 						external;
procedure ppChar(ch: ascii); 					external;
procedure pp5(ch: c5str; length: integer); 			external;
procedure pp10(ch: cstring; length: integer); 			external;
procedure pp10L(ch: cstring; length: integer);			external;
procedure pp20(ch: c20str; length: integer); 			external;
procedure pp20L(ch: c20str; length: integer); 			external;

procedure addEndStmnt (nextLinep: cursorpp; var nogood,emptyp,flushp: boolean; 
	var l,ocur: integer); external;
procedure addEndStmnt;
 var i: integer; 
 begin
 with curToken do 
  if nextLinep↑.stmntp and (nextLinep↑.st↑.stype = stmnt) then
    begin				(* move to previously defined stmnt *)
    i := ord(idGet(nextLinep↑.st,0,0));	(* & get any block id *)
    deleteLines(ocur,1,1);		(* flush the extra line *)
    if not fparse then
      begin
      l := cursorLine - topDline + 1;	(* offset into line array *)
      relLine(lines[l]);		(* release old line *)
      lines[l] := nil;
      end
     else if cursor = 3 then endOfLine := true;
    end
   else
    begin
    pp20L('Can''t have an END/CO',20); pp10('END here  ',8); errPrnt;
    nogood := true;
    flushp := true;
    end;
 end;

procedure add2Aux (nextLinep: cursorpp; var l,ocur,lcur: integer; 
	var nogood,flushp: boolean; slabel: varidefp; labp: boolean); external;
procedure add2Aux;
 begin
 with curToken do
 if endOfLine and (not fParse) and
    nextLinep↑.stmntp and (nextLinep↑.st↑.stype = cmtype) then
   begin
   nextLinep↑.st↑.deferCm := true;
   l := cursorLine - topDline + 2;
   relLine(lines[l]);				(* fix up lines array *)
   lines[l] := nil;
   firstLine := ocur;
   lastLine := lcur;
   curLine := 0;
   putStmnt(dprog,0,99);			(* re-display old line *)
   putLine;
   lines[l] := lines[l-1];
   lines[l-1] := nil;
   nogood := (slabel = nil) and not labp;	(* flush line if no label *)
   if nogood then ocur := ocur + 1;
   end
  else
   begin
   pp20L(' Expecting an ON her',20); ppChar('e'); errPrnt;
   nogood := true;
   flushp := true;
   end
 end;

procedure add4Aux (sp: statementp; var lcur,ocur: integer; slabel: varidefp;
	nextLinep: cursorpp; nogood,emptyp,stOk,clOk: boolean; 
	var firstTime,flushp: boolean); external;
procedure add4Aux;
 var j: integer; b: boolean;
 begin
 with curToken do 
  begin
  if sp <> nil then
    begin
    if (sp↑.nlines > 1) and (lcur > 0) then
      begin
      insertLines(ocur+1,sp↑.nlines-1,1); (* make room for the extra lines *)
      lcur := lcur + sp↑.nlines - 1;
      end
    end
   else if slabel <> nil then
    if nextLinep↑.stmntp then
      with nextLinep↑.st↑ do
       begin
       stlab := slabel;
       slabel↑.s := nextLinep↑.st;
       nlines := nlines + 1;
       end
     else
      begin pp20L(' Label has nothing t',20); pp10('o label   ',7); errPrnt end;

  if sParse then j := 0 else j := addNewDeclarations;

  if nogood and (not emptyp) and (ocur = cursorLine) then
    deleteLines(ocur,1,1)
   else
    begin
    ocur := ocur + j;
    lcur := lcur + j;
    firstLine := ocur;
    lastLine := lcur;
    setCursor := true;
    cursorLine := cursorLine + 1;
    curLine := 0;
    if not sParse then putStmnt(dprog,0,99)	(* write & display new line *)
     else
      begin
      cursor := sCursor - 1;
      putStmnt(cursorStack[sCursor].st,0,99)
      end;
    if fParse then setCursor := false
     else
      begin
      adjustDisplay;			(* make sure cursor is on screen *)
      displayLines(lineNum);
      end;
    end;
  firstTime := false;
  flushcomments := false;		(* comments are ok here *)
  if flushp then getToken;
  while flushp and not endOfLine do	(* in case of errors *)
   begin				(* leave things in a "clean" state *)
   if ttype = reswdtype then
     if (stOk and (rtype = stmnttype) and (stmnt <> assigntype)) or
	(clOk and (rtype = filtype) and
		  (filler in [totype,viatype,withtype])) then
       begin flushp := false; backup := true end
      else getToken			(* try next token *)
    else if (ttype = delimtype) and (ch = ';') then flushp := false
    else getToken;			(* if still bad try next token *)
   end;
  if not sParse then			(* skip semi's *)
    begin
    repeat getToken until (ttype <> delimtype) or (ch <> ';');
    backup := true;
    end
   else if cursor < sCursor then
    begin
    cursor := sCursor;
    emptyp := false;
    b := not elseTest;		(* ELSE ok here? *)
    if not b then
      begin
      cursor := sCursor;
      descend(cursorStack[sCursor].st);	(* how about a motion clause? *)
      with cursorStack[cursor].st↑ do
       b := (movetype <= stype) and (stype <= floattype);
      end;
    if b then
      begin
      getToken;			(* check for ELSE or clause *)
      backup := true;
      endOfLine := (ttype = delimtype) and (ch = ';');
      end
     else endOfLine := true;
    cursor := sCursor;
    end;
  end;
 end;